home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d17 / isigns50.arc / ASK.PAS next >
Pascal/Delphi Source File  |  1989-11-03  |  16KB  |  447 lines
  1. PROCEDURE ask_t;    {f/sign format}
  2. VAR char_ans : CHAR;       {used for single char inut}
  3. BEGIN
  4.     WRITELN('One can change to type of sign to format the output horizontally');
  5.     WRITELN('across page (sign) or vertically down page (banner).  Do you want');
  6.     WRITE('a Sign or Banner? (S/B) -> ');
  7.     highvideo; char_ans := READKEY;
  8.     CASE char_ans OF
  9.         'B','b' : sign_type := banner;
  10.         'S','s' : sign_type := sign
  11.     END; {case}
  12.     disp_t;
  13.     avail_space
  14. END; {procedure ask_t}
  15.  
  16.  
  17. PROCEDURE ask_b;    {f/block type}
  18. VAR char_ans : CHAR;       {used for single char inut}
  19.      siz_ans : STRING[3];  {used for number input}
  20.      num,err : INTEGER;
  21. BEGIN
  22.     WRITELN('The graphic characters may be made of the letter of the character');
  23.     WRITELN('itself, two different type of blocks, or Graphic bits.  Do you want to print');
  24.     WRITE('Single-strike Blocks, Overstrike blocks, Letters, or Bits? (S/O/L/B) -> ');
  25.     highvideo; char_ans := READKEY;
  26.     CASE char_ans OF
  27.         'S','s' : BEGIN
  28.                       block_type := block;
  29.                       GOTORC(22,1); CLREOL; lowvideo;
  30.                       WRITE('Enter decimal number of character to use ->'); highvideo;
  31.                       READLN(siz_ans);
  32.                       IF siz_ans <> '' THEN BEGIN
  33.                           VAL(siz_ans,num,err);
  34.                           block_char := CHR(num)
  35.                       END
  36.                   END;
  37.         'L','l' : block_type := letter;
  38.         'O','o' : block_type := overstrike;
  39.         'B','b' : IF output_device <> printr THEN BEGIN
  40.                        WRITELN;
  41.                        WRITE('Bits aren''t available for this output device');
  42.                        sak
  43.                   END ELSE
  44.                        block_type := bit;
  45.     END; {case}
  46.     disp_b;
  47.     disp_d;
  48.     disp_p;
  49.     disp_l;
  50.     disp_v;
  51.     avail_space;
  52. END; {procedure_ask_b}
  53.  
  54.  
  55. PROCEDURE ask_f;    {f/font file}
  56. VAR strng_ans1,strng_ans2 : S14; {used for filename input}
  57.     ok : BOOLEAN;
  58. BEGIN
  59.     ok := TRUE;
  60.     WRITELN('The HP-LaserJet compatible soft font file and associated MkFntNfx-created');
  61.     WRITELN('index defines all characters.  The default extension for the HP font is .FNT');
  62.     WRITELN('and .FNX for the index.  The index filename must match the HP font filename');
  63.     WRITE('Enter FileName of HP Font File -> ');
  64.     highvideo; READLN(strng_ans1);
  65.     IF POS('.',strng_ans1) <> 0 THEN
  66.         strng_ans2 := COPY(strng_ans1,1,POS('.',strng_ans1)-1)
  67.     ELSE
  68.         strng_ans2 := strng_ans1;
  69.     init_ff(strng_ans1,strng_ans2,ok);
  70.     disp_fs;
  71.     disp_f
  72. END; {procedure ask_f}
  73.  
  74.  
  75. PROCEDURE ask_w;    {f/width multiplier}
  76. VAR            err : INTEGER;    {err code from strng-to-num convert}
  77.            siz_ans : STRING[3];  {used for number input}
  78. BEGIN
  79.     WRITELN('One can make the letters of the sign or banner bigger in width');
  80.     WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
  81.     WRITE('Enter multiplier for width -> ');
  82.     highvideo; READLN(siz_ans);
  83.     IF siz_ans <> '' THEN VAL(siz_ans,mult_w,err);
  84.     disp_w
  85. END; {procedure ask_w}
  86.  
  87.  
  88. PROCEDURE ask_h;    {f/height multiplier}
  89. VAR            err : INTEGER;    {err code from strng-to-num convert}
  90.            siz_ans : STRING[3];  {used for number input}
  91. BEGIN
  92.     WRITELN('One can make the letters of the sign or banner bigger in height');
  93.     WRITELN('by entering a multiplier.  2 doubles size, 3 triples, etc.');
  94.     WRITE('Enter multiplier for height -> ');
  95.     highvideo; READLN(siz_ans);
  96.     IF siz_ans <> '' THEN VAL(siz_ans,mult_h,err);
  97.     disp_h
  98. END; {procedure ask_h}
  99.  
  100.  
  101. PROCEDURE ask_v;    {f/inverse video}
  102. VAR char_ans : CHAR;       {used for single char inut}
  103. BEGIN
  104.     WRITELN('This option reverses spaces to characters and vice-versa, effectively');
  105.     WRITELN('changing the output to reverse video.  The background is the defined single');
  106.     WRITE('block character.  Do you want Reverse Video output?  (Y/N) -> ');
  107.     highvideo; char_ans := READKEY;
  108.     CASE char_ans OF
  109.         'N','n' : inv_video := FALSE;
  110.         'Y','y' : inv_video := TRUE
  111.     END; {case}
  112.     disp_v
  113. END; {procedure ask_v}
  114.  
  115.  
  116. PROCEDURE ask_a;    {f/auto-centering}
  117. VAR char_ans : CHAR;       {used for single char inut}
  118. BEGIN
  119.     WRITELN('This option is active only if the given left margin is zero.');
  120.     WRITELN('Output can be centered within the maximum output width.');
  121.     WRITE('Should output be automatically centered?  (Y/N) -> ');
  122.     highvideo; char_ans := READKEY;
  123.     CASE char_ans OF
  124.         'N','n' : centering := FALSE;
  125.         'Y','y' : centering := TRUE
  126.     END; {case}
  127.     disp_a
  128. END; {procedure ask_a}
  129.  
  130.  
  131. PROCEDURE ask_m;    {f/given left margin}
  132. VAR            err : INTEGER;    {err code from strng-to-num convert}
  133.            siz_ans : STRING[3];  {used for number input}
  134. BEGIN
  135.     WRITELN('One can enter a given left margin to position banners and signs');
  136.     WRITELN('on the paper.  If the given left margin is zero, automatic centering');
  137.     WRITE('can also be done.  Enter number for left margin -> ');
  138.     highvideo; READLN(siz_ans);
  139.     IF siz_ans <> '' THEN BEGIN
  140.         VAL(siz_ans,given_offset,err);
  141.         centering := FALSE
  142.     END;
  143.     disp_a;
  144.     disp_m
  145. END; {procedure ask_m}
  146.  
  147.  
  148. PROCEDURE ask_g;    {f/given device size}
  149. VAR            err : INTEGER;    {err code from strng-to-num convert}
  150.            siz_ans : STRING[3];  {used for number input}
  151. BEGIN
  152.     WRITELN('If this option is non-zero it will override any of the other');
  153.     WRITELN('output size commands.  One can enter a defined output device');
  154.     WRITE('size (max=',Max_Length,') which will be used for checks and centering -> ');
  155.     highvideo; READLN(siz_ans);
  156.     IF siz_ans <> '' THEN VAL(siz_ans,given_width,err);
  157.     avail_space;
  158.     disp_g
  159. END; {procedure ask_g}
  160.  
  161.  
  162. PROCEDURE ask_q;    {f/abort exit}
  163. VAR ans : CHAR;
  164. BEGIN
  165.     WRITE('Do you want to abort ''SIGNS'' and quit?  (Y/N) -> '^G);
  166.     highvideo; ans := READKEY;
  167.     IF ans IN ['y','Y'] THEN BEGIN
  168.         GOTORC(24,1);
  169.         WRITELN('aborting SIGNS ...');
  170.         HALT
  171.     END
  172. END; {procedure ask_q}
  173.  
  174.  
  175. PROCEDURE ask_x(VAR all_ok,font_f_open,out_f_open : BOOLEAN;
  176.                 old_ff,old_of : S14);    {f/exiting to input}
  177. LABEL quick_exit;
  178. VAR err : INTEGER;   {for results of VAL procedure}
  179.     temp1,temp2 : s14; {temporary, for type conversion STRING[14] = S14}
  180. BEGIN
  181.     all_ok := TRUE;
  182.     temp1 := font_fn; temp2 := font_fni;
  183.     IF NOT ff_open OR (old_ff <> font_fn) THEN init_ff(temp1,temp2,all_ok);
  184.              {open font file if not open or if changed}
  185.     IF sign_type = Banner THEN BEGIN
  186.         space_needed := (ndx_array[0].height * mult_h) + given_offset;
  187.         IF space_needed > avail_width THEN BEGIN
  188.             GOTORC(24,1); WRITE('Warning: Banner is too tall to fit across the output page!'^G);
  189.             sak;
  190.         END
  191.     END ELSE
  192.         space_needed := given_offset;
  193.     GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
  194.  
  195.     IF input_device = text_file THEN BEGIN     {open input file}
  196.         ASSIGN(in_file,in_fn);
  197.         {$I-} RESET(in_file); {$I+}
  198.         err := IORESULT;
  199.         IF err <> 0 THEN BEGIN
  200.             in_fn := '????';
  201.             GOTORC(24,1); highvideo;
  202.             WRITELN('ERR:',err,' opening Input file, check it!'^G);
  203.             sak;
  204.             all_ok := FALSE;
  205.             GOTO quick_exit
  206.         END {if bad open}
  207.     END; {if input from file}
  208.     IF out_f_open AND (output_device <> recd_file) THEN BEGIN
  209.             {if output is open and no needed, close old it}
  210.         {$I-} CLOSE(out_file); {$I+}             {close old file}
  211.         err := IORESULT;
  212.         IF err <> 0 THEN BEGIN
  213.             out_fn := '????';
  214.             GOTORC(24,1); highvideo;
  215.             WRITELN('ERR:',err,' closing output file, check it!'^G);
  216.             sak;
  217.             all_ok := FALSE;
  218.             GOTO quick_exit
  219.         END
  220.     END; {if no more file output}
  221.     IF output_device = recd_file THEN BEGIN
  222.         IF NOT out_f_open THEN BEGIN   {open it}
  223.             ASSIGN(out_file,out_fn);  {start file output}
  224.             {$I-} REWRITE(out_file); {$i+}
  225.             err := IORESULT;
  226.             IF err <> 0 THEN BEGIN
  227.                 out_fn := '????';
  228.                 GOTORC(24,1); highvideo;
  229.                 WRITELN('ERR:',err,' opening output file, check it!'^G);
  230.                 sak;
  231.                 disp_e;
  232.                 all_ok := FALSE;
  233.                 GOTO quick_exit
  234.             END ELSE
  235.                 out_f_open := TRUE;
  236.         END; {if new file output}
  237.         IF out_f_open AND (out_fn <> old_of) THEN BEGIN {change output file}
  238.             {$I-} CLOSE(out_file); {$I+}             {close old file}
  239.             err := IORESULT;
  240.             IF err <> 0 THEN BEGIN
  241.                 out_fn := '????';
  242.                 GOTORC(24,1); highvideo;
  243.                 WRITELN('ERR:',err,' closing old output file, check it!'^G);
  244.                 sak;
  245.                 all_ok := FALSE;
  246.                 GOTO quick_exit
  247.             END;
  248.             ASSIGN(out_file,out_fn);
  249.             {$I-} REWRITE(out_file); {$I+}            {open new file}
  250.             err := IORESULT;
  251.             IF err <> 0 THEN BEGIN
  252.                 out_fn := '????';
  253.                 GOTORC(24,1); highvideo;
  254.                 WRITELN('ERR:',err,' opening new output file, check it!'^G);
  255.                 sak;
  256.                 disp_e;
  257.                 all_ok := FALSE;
  258.                 GOTO quick_exit
  259.             END
  260.         END {if file output was changed}
  261.     END; {if file output is wanted}
  262. quick_exit:
  263. END; {procedure ask_x}
  264.  
  265.  
  266. PROCEDURE ask_i;    {f/input device}
  267. VAR char_ans : CHAR;       {used for single char inut}
  268. BEGIN
  269.     WRITELN('Input can come from the keyboard in which is is entered one line');
  270.     WRITELN('at a time or in a bunch from a external file.  Do you want to read');
  271.     WRITE('input from the Keyboard or File?  (K/F) -> ');
  272.     highvideo; char_ans := READKEY;
  273.     CASE char_ans OF
  274.         'F','f' : input_device := text_file;
  275.         'K','k' : input_device := keyboard
  276.     END; {case}
  277.     disp_r;
  278.     disp_n;
  279.     disp_i
  280. END; {procedure ask_i}
  281.  
  282.  
  283. PROCEDURE ask_r;    {f/text input file}
  284. VAR strng_ans : STRING[14]; {used for filename input}
  285. BEGIN
  286.     WRITELN('This entry is only active if input is read from a file.');
  287.     WRITELN('Enter filename of the text file to read that contains the');
  288.     WRITE('line(s) to be output  -> ');
  289.     highvideo; READLN(strng_ans);
  290.     IF strng_ans <> '' THEN in_fn := strng_ans;
  291.     disp_r
  292. END; {procedure ask_r}
  293.  
  294.  
  295. PROCEDURE ask_n;    {f/number of copies}
  296. VAR err : INTEGER;
  297. char_ans : CHAR;       {used for single char inut}
  298. BEGIN
  299.     WRITELN('This entry is only active if input is from a file.');
  300.     WRITELN('Multiple copies are separated by formfeeds.');
  301.     WRITE('How many copies do you want? -> ');
  302.     highvideo; char_ans := READKEY;
  303.     IF char_ans <> '' THEN VAL(char_ans,num_copies,err);
  304.     disp_n
  305. END; {procedure ask_n}
  306.  
  307.  
  308. PROCEDURE ask_o;    {f/output device}
  309. VAR char_ans : CHAR;       {used for single char inut}
  310. BEGIN
  311.     WRITELN('Output may be directed to the console screen, a file or the printer.');
  312.     WRITELN('File output is ',Max_Length,' wide unless specified otherwise.  Do you');
  313.     WRITE('want to output to a File, Screen or Printer?  (S/F/P) -> ');
  314.     highvideo; char_ans := READKEY;
  315.     CASE char_ans OF
  316.         'P','p' : output_device := printr;
  317.         'S','s' : output_device := screen;
  318.         'F','f' : output_device := recd_file
  319.     END; {case}
  320.     disp_y;
  321.     disp_p;
  322.     disp_l;
  323.     disp_c;
  324.     disp_e;
  325.     disp_o;
  326.     avail_space
  327. END; {procedure ask_o}
  328.  
  329.  
  330. PROCEDURE ask_s;    {f/device size}
  331. VAR char_ans : CHAR;       {used for single char inut}
  332. BEGIN
  333.     WRITELN('Enter (N) if the output device is either an 8" wide printer or');
  334.     WRITELN('80 char CRT; or (W) if it is a  14" printer or 132 char screen.');
  335.     WRITE('Is output device size Normal or Wide?  (N/W) -> ');
  336.     highvideo; char_ans := READKEY;
  337.     CASE char_ans OF
  338.         'W','w' : device_size := wide;
  339.         'N','n' : device_size := normal
  340.     END; {case}
  341.     avail_space;
  342.     disp_s
  343. END; {procedure ask_s}
  344.  
  345.  
  346. PROCEDURE ask_y;    {f/given device size}
  347. VAR            err : INTEGER;    {err code from strng-to-num convert}
  348.           char_ans : CHAR;       {used for single char input}
  349. BEGIN
  350.     WRITELN('Several printer drivers are available.  Enter (E)pson, (I)DS [also works');
  351.     WRITELN('for DataProducts] (H)p LaserJet, or (D)umb.  Dumb sends no control codes.');
  352.     WRITE('Printer?  (E/I/H/D?) -> ');
  353.     highvideo; char_ans := READKEY;
  354.     CASE char_ans OF
  355.         'E','e' : prt_type := epson;
  356.         'I','i' : prt_type := ids;
  357.         'H','h' : prt_type := hp;
  358.         'D','d' : prt_type := dumb
  359.     END; {case}
  360.     avail_space;
  361.     disp_y
  362. END; {procedure ask_y}
  363.  
  364.  
  365. PROCEDURE ask_p;     {f/pitch}
  366. VAR char_ans : CHAR;       {used for single char inut}
  367. BEGIN
  368.     WRITELN('This entry is active only if outputting to the printer.  It controls');
  369.     WRITELN('character spacing or pitch:  Enter (P)ica for 10 cpi, (E)lite for');
  370.     WRITE('12 cpi, (S)queezed for 16.5 cpi, (T)iny for 20 cpi?  (P/E/S/T?) -> ');
  371.     highvideo; char_ans := READKEY;
  372.     CASE char_ans OF
  373.         'P','p' : prt_cpi := pica;
  374.         'E','e' : prt_cpi := elite;
  375.         'S','s' : prt_cpi := squeezed;
  376.         'T','t' : prt_cpi := tiny
  377.     END; {case}
  378.     avail_space;
  379.     disp_p
  380. END; {procedure ask_p}
  381.  
  382.  
  383. PROCEDURE ask_l;    {f/line per inch}
  384. VAR char_ans : CHAR;       {used for single char inut}
  385. BEGIN
  386.     WRITELN('This entry is active only if outputting to the printer.');
  387.     WRITELN('This controls line spacing:  Enter (S) for 6 lpi,');
  388.     WRITE('(E)ight for 8 lpi, (T)en, or tWelve lpi?  (S/E/T/W) -> ');
  389.     highvideo; char_ans := READKEY;
  390.     CASE char_ans OF
  391.         'S','s' : prt_lpi := six;
  392.         'E','e' : prt_lpi := eight;
  393.         'T','t' : prt_lpi := ten;
  394.         'W','w' : prt_lpi := twelve
  395.     END; {case}
  396.     disp_l
  397. END; {procedure ask_l}
  398.  
  399.  
  400. PROCEDURE ask_c;    {f/color}
  401. VAR char_ans : CHAR;       {used for single char inut}
  402. BEGIN
  403.     WRITELN('This entry is active only if outputting to the printer.');
  404.     WRITELN('Printer can print in (R)ed, (G)reen, b(L)ue or (B)lack.');
  405.     WRITE('Enter color desired?  (R/G/L/B) ->');
  406.     highvideo; char_ans := READKEY;
  407.     CASE char_ans OF
  408.         'B','B' : prt_color := black;
  409.         'R','r' : prt_color := red;
  410.         'G','g' : prt_color := green;
  411.         'L','l' : prt_color := blue
  412.     END; {case}
  413.     disp_c
  414. END; {procedure ask_c}
  415.  
  416.  
  417. PROCEDURE ask_d;    {f/color}
  418. VAR char_ans : CHAR;       {used for single char inut}
  419. BEGIN
  420.     WRITELN('This entry is active only if outputting to the printer and bit output');
  421.     WRITELN('is requested.  Options are (S)ingle, (D)ouble, (T)riple, or (Q)uad');
  422.     WRITE('Graphic Density.  Enter (S/D/T/Q?) ->');
  423.     highvideo; char_ans := READKEY;
  424.     CASE char_ans OF
  425.         'S','s' : graphic_dens := single;
  426.         'D','d' : graphic_dens := double;
  427.         'T','t' : graphic_dens := triple;
  428.         'Q','q' : graphic_dens := quad
  429.     END; {case}
  430.     avail_space;
  431.     disp_d
  432. END; {procedure ask_d}
  433.  
  434.  
  435. PROCEDURE ask_e;    {f/record file}
  436. VAR strng_ans : STRING[14]; {used for filename output}
  437. BEGIN
  438.     WRITELN('This entry is only active if output is to be recorded in');
  439.     WRITE('a file.  Enter filename to record output into -> ');
  440.     highvideo; READLN(strng_ans);
  441.     IF strng_ans <> '' THEN out_fn := strng_ans;
  442.     avail_space;
  443.     disp_e
  444. END; {procedure ask_e}
  445.  
  446.  
  447.